home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / rptgen / rptmain.bas < prev   
BASIC Source File  |  1995-05-09  |  16KB  |  492 lines
  1.  
  2. Function RptCreate (rtitle$, numcols%, textcols%, nrows%, thinbars%, thickbars%, tit1$, tit2$, foot1$, foot2$)
  3. '   function to create a new report
  4. '   Graham Hobson   (72506,3410)    Created: 24th September, 1991
  5. '
  6. ' Parameters:
  7. '   rtitle$ is the caption for the report form
  8. '   numcols is the number of numeric columns
  9. '   textcols is the number of text columns
  10. '   nrows is the maximum number of rows for the report (may be larger than one page)
  11. '   thinbars number (n) says to draw a thin line on the printed report every n rows
  12. '           use zero if you don't want any thinbars
  13. '   thickbars, ditto but with a thicker line
  14. '   tit1 is the main title
  15. '   tit2 is the secondary title
  16. '   foot1 is the first footnote
  17. '   foot2 is the second footnote
  18.  
  19. On Error GoTo memerror
  20. ncols% = numcols% + textcols%
  21. If ncols% < 1 Then MsgBox "Error: there must be one or more columns", 16, "RptCreate"
  22. ReDim RptCol(1 To ncols%) As RptCol_Type
  23. If numcols% > 0 Then ReDim RptNumData(1 To numcols%, 1 To nrows%) As Single
  24. If textcols% > 0 Then ReDim RptTextData(1 To textcols%, 1 To nrows%) As String
  25. ReDim RptSortTop(10) As Integer
  26. ReDim RptSortBottom(10) As Integer
  27.  
  28. RptForm.Show
  29. RptForm.caption = rtitle$
  30. RptForm.Refresh
  31.  
  32. rpt.name = rtitle$
  33. rpt.headerheight = 600
  34. rpt.defrowheight = 225
  35.  
  36. rpt.thinbars = thinbars%
  37. rpt.thickbars = thickbars%
  38. If rpt.thinbars = 0 Then rpt.thinbars = 9999
  39. If rpt.thickbars = 0 Then rpt.thickbars = 9999
  40.  
  41. RptForm.LAB_title1.caption = tit1$
  42. RptForm.LAB_title2.caption = tit2$
  43. RptForm.LAB_footnote1.caption = foot1$
  44. RptForm.LAB_footnote2.caption = foot2$
  45.  
  46. rpt.cols = ncols%
  47. rpt.numcols = numcols%
  48. rpt.textcols = textcols%
  49. rpt.rows = nrows%
  50.  
  51. ' work out number of rows per page
  52. rpt.rowsperpage = (Printer.height - 1750 - 2000 - rpt.headerheight) / (rpt.defrowheight + 15)
  53. rpt.pages = (rpt.rows \ rpt.rowsperpage) + 1
  54.  
  55. RptForm.grid1.cols = rpt.cols
  56. RptForm.grid1.rows = rpt.rowsperpage + 1
  57.  
  58. rpt.currentnumcol = 0
  59. rpt.currenttextcol = 0
  60. RptCreate = 0
  61. Exit Function
  62.  
  63. memerror:
  64. MsgBox "Error: report too large!", 16, "RptCreate"
  65. RptCreate = -1
  66.  
  67. End Function
  68.  
  69.  
  70. Sub RptDefineColumn (Rhnd%, colno%, ctype$, ctitle$, cwidth%, calign%, cfmt$, bar%)
  71. ' routine to create a new column
  72. '   Rhnd is a report handle (not currently used)
  73. '   colno is the column number (from 1 to max)
  74. '   ctype is the datatype: A for text and 9 for numeric
  75. '   ctitle is the column title
  76. '   cwidth is the default width in twips
  77. '   calign is the alignment: 0 = left, 1 = centred, 2 = right
  78. '   cfmt is a standard VB format string used to format each cell value
  79. '   bar is a flag indicating if a vertical bar should be drawn on the printed report
  80. '       0 (FALSE) = no, -1 (TRUE) = yes
  81.  
  82. If colno% < 1 Or colno% > rpt.cols Then MsgBox "invalid column number", 16, "RptDefineColumn"
  83.  
  84. RptCol(colno%).fmt = cfmt$
  85. RptCol(colno%).bar = bar%
  86. RptCol(colno%).datatype = ctype$
  87. RptCol(colno%).ctitle = ctitle$
  88. RptCol(colno%).cwidth = cwidth%
  89. RptCol(colno%).calign = calign%
  90.  
  91. ' set pointer to data column
  92. If ctype$ = "9" Then
  93.     If rpt.currentnumcol < rpt.numcols Then
  94.         rpt.currentnumcol = rpt.currentnumcol + 1
  95.         RptCol(colno%).ptr = rpt.currentnumcol
  96.     Else
  97.         MsgBox "too many numeric columns", 16, "RptDefineColumn"
  98.     End If
  99. ElseIf ctype$ = "A" Then
  100.     If rpt.currenttextcol < rpt.textcols Then
  101.         rpt.currenttextcol = rpt.currenttextcol + 1
  102.         RptCol(colno%).ptr = rpt.currenttextcol
  103.     Else
  104.         MsgBox "too many text columns", 16, "RptDefineColumn"
  105.     End If
  106. Else
  107.     MsgBox "Invalid datatype", 16, "RptDefineColumn"
  108. End If
  109.  
  110. If cwidth% <= 0 Then MsgBox "invalid column width", 16, "RptDefineColumn"
  111.  
  112. RptForm.grid1.col = colno% - 1
  113. RptForm.grid1.row = 0
  114. RptForm.grid1.text = ctitle$
  115. RptForm.grid1.colwidth = cwidth%
  116. RptForm.grid1.rowheight = rpt.headerheight
  117. RptForm.grid1.colalignment = calign%
  118.  
  119. ' set sort menu item
  120. If colno% > 1 Then Load RptForm.MSort(colno%)
  121. RptForm.MSort(colno%).caption = "&" + Format$(colno%) + "." + ctitle$
  122. End Sub
  123.  
  124. Sub RptDelete (Rhnd%)
  125. Unload RptForm
  126. End Sub
  127.  
  128. Sub RptNewPage (Rhnd%, page%)
  129. ' procedure to display specified page of a report
  130. ' report handle is ignored currently
  131. If page% > rpt.pages Or page% < 1 Then MsgBox "invalid page number", 16, "RptNewPage"
  132.  
  133. Screen.MousePointer = 11
  134. '-----------
  135. ' clear grid control
  136.     x% = RptForm.grid1.col
  137.     y% = RptForm.grid1.row
  138.     RptForm.grid1.Selstartrow = 1
  139.     RptForm.grid1.SelStartcol = 0
  140.     RptForm.grid1.Selendrow = RptForm.grid1.rows - 1
  141.     RptForm.grid1.Selendcol = RptForm.grid1.cols - 1
  142.     RptForm.grid1.clip = ""
  143.     RptForm.grid1.Selstartrow = 1
  144.     RptForm.grid1.SelStartcol = 1
  145.     RptForm.grid1.Selendrow = 1
  146.     RptForm.grid1.Selendcol = 1
  147. '-----------
  148.  
  149. rpt.page = page%    ' set current page number
  150. RptForm.caption = RTrim$(rpt.name) + " - (Page " + Format$(rpt.page) + " of " + Format$(rpt.pages) + ")"
  151.  
  152. ' populate grid with data for current page
  153. For y% = ((page% - 1) * rpt.rowsperpage) + 1 To (page% * rpt.rowsperpage)
  154.     If y% > rpt.rows Then Exit For
  155.     For x% = 1 To rpt.cols
  156.         RptForm.grid1.row = y% Mod rpt.rowsperpage
  157.         If RptForm.grid1.row = 0 Then RptForm.grid1.row = rpt.rowsperpage
  158.         RptForm.grid1.col = x% - 1
  159.         
  160.         If RptCol(x%).datatype = "9" Then
  161.             RptForm.grid1.text = Format$(RptNumData(RptCol(x%).ptr, y%), RTrim$(RptCol(x%).fmt) + " ")
  162.         Else
  163.             RptForm.grid1.text = RptTextData(RptCol(x%).ptr, y%)
  164.         End If
  165.     Next
  166. Next
  167.  
  168. RptForm.Refresh
  169. Screen.MousePointer = 0
  170. End Sub
  171.  
  172. Sub RptPrint (Rhnd%)
  173. ' prints current report page.  Report handle is currently ignored
  174.  
  175. Screen.MousePointer = 11
  176. RptForm.TXT_status.visible = -1
  177. RptForm.TXT_status.text = "Printing page " + Format$(rpt.page) + " of " + Format$(rpt.pages)
  178.  
  179. Printer.fontname = Printer.fonts(3)     ' universe on an HP laserjet
  180.  
  181. '--------------------------------------------------------
  182. ' get max width and height of grid by looping thru columns and rows
  183. '--------------------------------------------------------
  184. maxwidth% = 0
  185. maxheight% = rpt.headerheight + 15
  186. For y% = 1 To rpt.rowsperpage
  187.     RptForm.grid1.row = y%
  188.     If RptForm.grid1.text = "" Then Exit For
  189.     maxheight% = maxheight% + rpt.defrowheight + 15
  190. Next
  191. For x% = 0 To rpt.cols - 1
  192.     RptForm.grid1.col = x%
  193.     maxwidth% = maxwidth% + RptForm.grid1.colwidth + 15
  194. Next
  195.  
  196. '----------------------------
  197. ' date and pagenumber
  198. '----------------------------
  199. Printer.fontsize = 9
  200. Printer.currentx = 550
  201. Printer.currenty = 380
  202. Printer.Print Format$(Now, "dd mmmm, yyyy");
  203. Printer.currentx = Printer.width - Printer.TextWidth("Page " + Format$(rpt.page)) - 1300
  204. Printer.Print "Page " + Format$(rpt.page)
  205.  
  206. '----------------------------
  207. ' main title
  208. '----------------------------
  209. Printer.fontbold = -1
  210. Printer.fontsize = 16
  211. Printer.currentx = ((Printer.width - Printer.TextWidth(RptForm.LAB_title1.caption)) / 2) - 400
  212. Printer.currenty = 620
  213. Printer.Print RptForm.LAB_title1.caption
  214.  
  215. '----------------------------
  216. ' second title
  217. '----------------------------
  218. Printer.fontbold = 0
  219. Printer.fontsize = 12
  220. Printer.currentx = ((Printer.width - Printer.TextWidth(RptForm.LAB_title2.caption)) / 2) - 400
  221. Printer.currenty = 1100
  222. Printer.Print RptForm.LAB_title2.caption
  223.  
  224. '----------------------------
  225. ' footnotes
  226. '----------------------------
  227. Printer.fontbold = 0
  228. Printer.fontsize = 9
  229. Printer.currentx = 550
  230. Printer.currenty = Printer.height - 1600
  231. Printer.Print RptForm.LAB_footnote1.caption
  232. Printer.currentx = 550
  233. Printer.currenty = Printer.height - 1200
  234. Printer.Print RptForm.LAB_footnote2.caption
  235.  
  236. ' draw grid
  237. Printer.fontsize = 8.25
  238.  
  239. If (Printer.width - maxwidth%) > 800 Then
  240.     orgx% = ((Printer.width - maxwidth%) / 2) - 400     ' centred report
  241. Else
  242.     orgx% = 400     ' won't fit so left justified
  243. End If
  244. orgy% = 1750
  245.  
  246. '--------------------------------------------------------
  247. ' draw outline of report table with shadows
  248. '--------------------------------------------------------
  249. Printer.currentx = orgx%
  250. Printer.currenty = orgy%